.TITLE	DCSUB - Subroutines
	.IDENT	/05.00/
	.IF DF	D$$CHE
;
; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A.
; All rights reserved.
;
; Original author:
;	John Gemignani
;
; Previously modified by:
;
;	D. Carroll
;	J. Kauffman
;	L. B. McCulley
;
; Modified for RSX-11M-PLUS V4.6 by:
;
;	D. Carroll	08-Jan-1996		05.00
;		DC430 - Include support for 32-bit LBNs
;
;
; This module contains various routines to support disk data caching.
;
	.MCALL	HDRDF$
	.MCALL	SHDDF$

	HDRDF$				; Define the Header offsets
	SHDDF$

	.PSECT	DC$SUB,RO,I

	.SBTTL	SEARCH - Search for the first overlapping extent
	.SBTTL	SRCHP - Search for next overlapping extent (from set position)
;+
; SEARCH passed:
;	R1 -> User's I/O request packet (URP)
;	UCBX mapped
;
; SRCHP passed:
;	R0 -> CED at which search begins
;	R1 -> URP
;	Cache partition mapped
;
;
; Returned:
;	R2 := LSB (Least Significant Part) of the highest requested block
;	R3 := MSP (Most Significant Part)
;	R4 := Length of the transfer in blocks
;
;	CC:	R0 -> First overlapping extent
;	CS:	Indicates no overlapping extents
;		H.TMP -> CED prior to current (zero denotes beginning of list)
;
;	Cache partition mapped
;-
	.enabl	lsb
SEARCH::
	MOV	APR6.BASE+X.CCED, R0	; Get the first extent

	MP$PAR				; Map the cache partition
	CLR	APRD.BASE+H.TMP		; init the lbn list position to
	BR	10$			; and start search


SRCHP::					; partial search - position in CED list
	MOV	R0,APRD.BASE+H.TMP	; beginning of list as current p
	BNE	10$			; ok, start searching

	MP.UCBX				; no current position, map UCBX
	BR	SEARCH			; and SEARCH from beginning


10$:	MOV	I.PRM+P4(R1), R3	; Get MSP of requested LBN		;DC430
	BIT	#DV.32B,U.CW1(R5)	; does this device support 32-bit LBNs	;DC430
	BNE	11$			; if NE, yes, continue			;DC430
	BIC	#177400,R3		; clean up the high byte		;DC430
										;DC430
11$:	MOV	I.PRM+P5(R1), R2	; and LSP				;DC430
										;**-2
	MOV	R2, -(SP)		; Put a copy on the stack
	MOV	R3, -(SP)

	CALL	CLCLEN			; calculate xfr length in blocks

	DEC	R4			; Backup one block temporarily

	ADD	R4, 2(SP)		; Calculate highest LBN requeste
	ADC	(SP)			; Carry if necessary

	INC	R4			; Restore to full size requested

	TST	R0			; are we at beginning of an empty list
	BEQ	50$			; If EQ, no CED to scan = all done
;
; Don't forget that the extent high LBN is stored +1.
;
15$:
	CMP	R3, E.LBNH+2(R0)	; Might this extent overlap?		;DC430
	BHI	20$			; If HI, no, check next extent		;**-1
	BLO	30$			; If LO, yes
	CMP	R2, E.LBNH(R0)		; Double word comparison
	BLO	30$			; If LO, yes

20$:	MOV	R0, APRD.BASE+H.TMP	; Update pointer to current CED
	MOV	E.LNXT(R0), R0		; Get next extent
	BNE	15$
	BR	50$

30$:	CMP	(SP), E.LBNL+2(R0)	; Does this extent truly overlap	;DC430
	BHI	40$			; If HI, yes				;**-1
	BLO	50$			; If LO, no
	CMP	2(SP), E.LBNL(R0)	; Double word comparison
	BLO	50$			; If LO, no

40$:	CLC				; Indicate overlap found
	BR	60$

50$:	SEC				; Indicate no overlap

60$:	MOV	(SP)+, R3
	MOV	(SP)+, R2

	RETURN
	.dsabl	lsb

	.sbttl	+	CLCLEN, Calculate transfer length from URP
;+
; CLCLEN - Calculate length of transfer in blocks, from I/O packet byte
;	   count
;
;	Input:
;		R1 - URP
;
;	Output:
;		R4 - Number of blocks requested
;
;	All other registers preserved
;-
CLCLEN::MOV	I.PRM+P2(R1), R4	; Get the request size (bytes)
	ADD	#777, R4		; Round up
	ROR	R4			; Bring carry in as high bit.
	SWAB	R4			; Finish right shift of nine bits
	BIC	#177400,R4		; Clear unwanted bits.
	RETURN


	.SBTTL	+	GETCRP - allocate Cache Rqst Pkt and save URP contents
;+
;  **-GETCRP - allocate Cache Rqst Pkt and save URP contents
;
; Passed:
;	R1 -> User I/O Request Packet (URP, in system pool)
;
;	Cache Partition mapped
;
; Returned:
;	CS - CRP allocation failed (unlikely, FREAGE should free resource
;	CC - Cache Request Packet (CRP) successfully allocated in pool
;
;	R2 -> CRP, 	URP values copied to CRP
;		(see DCPRE for CRP contents and offset definitions)
;	I.AADA (R1) -> CRP
;	I.AADA+2 (R1) = 0	for later use as CED pointer
;-
GETCRP::MOV	R0,-(SP)		; Save work registers
	MOV	R1,-(SP)		; Save pointer register

10$:	MOV	#R.LGTH,R1		;Set length to allocate

	.if	df,p$$ctl		; pool monitoring support included?

	MOV	#<3*I.LGTH>,-(SP)	; add margin for i/o pkts in minimum

	.if	df,i$$cbp		; using ICB pool?
	TST	$PRILL			; is it set at ICB pool for the limit?
	BMI	12$			; if MI, just require some pool
	.endc	;df,i$$cbp

	ADD	$PRILL,(SP)		; free at which to use pool first
12$:	CMP	$PRISZ,(SP)+		; more now free?
	BLOS	15$			; no, use internal pool first

	.iftf	; p$$ctl

	CALL	$ALOCB			; try to use sys pool
	BCC	100$			; ok

	MOV	(SP),R1			; set up for USTAT$
	USTAT$	0,#APR6.BASE+S.POL
	MOV	#R.LGTH,R1		; reset length

15$:	CALL	.ALOCB			;Request the space
	BCC	100$			;Got space

	MOV	(SP),R1			; set up for USTAT$
	USTAT$	0,#APR6.BASE+S.PSP
	MOV	#R.LGTH,R1		; reset length

	.ift	; p$$ctl

	CALL	$ALOCB			; try to use sys pool
	BCC	100$			; ok

	MOV	(SP),R1			; set up for USTAT$
	USTAT$	0,#APR6.BASE+S.POL


	.endc

	CALL	FREAGE			;Delete oldest CED to free pool
	BCC	10$			;and try again (should succeed now
	BR	90$			;nfg, return a failure

100$:	MOV	R0,R2			; set pointer register to be returned
	MOV	(SP),R1			; restore User Request Packet ptr
	MOV	R1,R.URP(R2)		; point CRP to URP

	MOV	I.AADA(R1),R.AADA(R2)	; save URP attachment ptrs in CRP
	MOV	I.AADA+2(R1),R.AADA+2(R2)
	MOV	R2,I.CRP(R1)		; set CRP ptr in URP
	CLR	I.ACED(R1)		; clear CED pointer in URP

;+
; Save initial User I/O Request Packet (URP) context.
;-
	MOVB	I.FCN(R1),R.FCN(R2)	; save I.FCN modifier byte
	MOVB	I.EFN(R1),R.EFN(R2)	; save virtual user op flag
	MOV	I.IOSB+2(R1),R.IOSB2(R2) ; save user IOSB address
	MOV	I.IOSB+4(R1),R.IOSB2+2(R2) ; save user IOSB APR base
	MOV	I.PRM+P1.1(R1),R.P1.1(R2) ; save user I.PRM values
	MOV	I.PRM+P1.2(R1),R.P1.2(R2)
	MOV	I.PRM+P2(R1),R.P2(R2)
	CLR	R.P3(R2)		; initialize the total byte count
	MOV	I.PRM+P4(R1),R.P4(R2)
	MOV	I.PRM+P5(R1),R.P5(R2)

90$:	MOV	(SP)+,R1		; restore URP ptr for failures
	MOV	(SP)+,R0		; restore both work registers
	RETURN


	.SBTTL	+	RFRSHP -- refresh original User Request Packet from CRP
;+
; RFRSHP  refreshes User Request Packet with original parameters
;	  saved in Cache Request Packet
;	  NOTE: does not mung driver status return in I.PRM+P3
;
; Passed:
;	R1 -> URP
;
; Returns:
;	URP refreshed
;	R2 -> CRP
;	All other registers preserved
;-
RFRSHP::MOV	I.CRP(R1),R2		; get CRP pointer from URP
	CMP	(R2),R1			; is this the correct CRP?
	BEQ	5$			; if EQ, nope ...

	FATAL$	BE.DDA			; double deallocation attempted

5$:	MOVB	R.FCN(R2),I.FCN(R1)	; restore I.FCN modifier byte
	MOVB	R.EFN(R2),I.EFN(R1)	; restore virtual user op flag
	MOV	R.IOSB2(R2),I.IOSB+2(R1) ; restore user IOSB address
	MOV	R.IOSB2+2(R2),I.IOSB+4(R1) ; restore user IOSB APR base

	MOV	R.P1.1(R2),I.PRM+P1.1(R1) ; restore current I.PRM values
	MOV	R.P1.2(R2),I.PRM+P1.2(R1)
	MOV	R.P2(R2),I.PRM+P2(R1)	; don't mung I.PRM+P3 driver status
	MOV	R.P4(R2),I.PRM+P4(R1)
	MOV	R.P5(R2),I.PRM+P5(R1)

	RETURN

	.SBTTL	+	UPDPKT -- refresh URP and update for segments xfr
;+
; UPDPKT -- refresh URP then update params for segments previously transfer
;
; Passed:
;	R1 -> URP
;
; Return:
;	R2 -> CRP
;
;-
UPDPKT::CALL	RFRSHP			; refresh original params

	; update request parameters for bytes transferred in all prev sequences

	MOV	R4,-(SP)		; save work register for CLCLEN
	MOV	R.P3(R2),R4		; get bytes transferred so far

	ADD	R4,I.PRM+P1.2(R1) 	; update next user buffer phys address
	ADCB	I.PRM+P1.1+1(R1)	; maybe carry into hi order phys addr
;NOTE ->				; NOTE - requires 22-bit system

	SUB	R4,I.PRM+P2(R1) 	; reduce length remaining

	MOV	I.PRM+P2(R1),-(SP)	; save count of requested bytes

	MOV	R4,I.PRM+P2(R1)		; change to bytes transferred so far
	CALL	CLCLEN			; return blocks transferred in R4
	ADD	R4,I.PRM+P5(R1)		; update next starting LBN request
	ADC	I.PRM+P4(R1)		; ..double prec..

	MOV	(SP)+,I.PRM+P2(R1)	; restore count of requested bytes
	MOV	(SP)+,R4		; restore work register
	RETURN


	.SBTTL	+	RLSCRP -- refresh URP from CRP and delete CRP
;+
; RLSCRP	refresh URP with original context from CRP then delete CRP
;		Offset R.P3 has been used to accumulate total bytes
;		transferred by segments processed previously, propogate
;		it into I.PRM+P3 in case it should be returned by $IOFIN
;
; Passed:
;	R1 -> URP
;	I.CRP(R1) -> CRP
;
; Returns:
;	R2 destroyed,
;	URP updated,
;	CRP deleted.
;-
RLSCRP::CALL	RFRSHP		; refresh URP from CRP

	MOV	R.P3(R2),I.PRM+P3(R1)	; propogate transfer total

	CALL	DELCRP		; delete CRP
	RETURN

	.SBTTL	+	DELCRP - Deallocate cache request descriptor
;+
;  Passed:
;	R2 -> CRP to deallocate
;
;	Cache Partition mapped
;
;  Returned:
;	All registers preserved
;-
DELCRP::MOV	R0, -(SP)		; save R0
	MOV	R1, -(SP)		;  and R1

	MOV	R.URP(R2),R1		; get address of URP

	CMP	I.CRP(R1),R2		; does this URP point to the CRP
	BEQ	5$			; yes, continue ...

	FATAL$	BE.DDA			; double deallocation

5$:	TST	I.ACED(R1)		; do we have an attached CED
	BEQ	7$			; if EQ, nope, continue ...

	FATAL$	BE.CAA			; CED is attached at deletion

7$:	MOV	R.AADA(R2),I.AADA(R1)	; restore URP attachments
	MOV	R.AADA+2(R2),I.AADA+2(R1)	; both parts

	MOV	R2,R0			; set CRP address to delete
	MOV	#R.LGTH, R1		; Length of cache request descriptor
	CALL	.DEACB			; Release the block

	MOV	(SP)+, R1		; restore R1
	MOV	(SP)+, R0		;    and R0
	RETURN

	.SBTTL	+	Q2PHS1	queue operations to phase 2 queue
	.SBTTL	+	Q2PHS2	queue operations to phase 2 queue
;+
; Q2PHS1 - queue request to phase II, and force a fork
; Q2PHS2 - queues a request to phase 2
;	  (used in DCCTL if other requests remain in rundown)
;
;
;	Input:
;		R1 - URP to queue into phase II
;
;	Cache partition mapped
;-
Q2PHS1::
	BISB	#CS.DNF,APRD.BASE+H.CSTS	; force a fork
Q2PHS2::
	CMP	APRD.BASE+H.PAVL,#3	; is this really a cache region?
	BNE	10$			; nope, go die in disgrace

	MOV	R1,@APRD.BASE+H.PKTQ+2	; queue us to be the last one
	MOV	R1,APRD.BASE+H.PKTQ+2	; set pointer to end of list
	CLR	(R1)			; show end of list
	RETURN

10$:	FATAL$	BE.IDC			; cache partition not mapped

	.SBTTL	+	Q2DRVR	queue operations to driver during deactivation
;+
; Q2DRVR - queue request for dispatch after deactivation completes
;	  (called from DCCHE and DCCTL during deactivation processing)
;
;	Input:
;		R1 - URP to queue into phase II
;-
Q2DRVR::MP.PAR				; map cache partition
	MOV	R1,@APRD.BASE+H.DACTQ+2
	MOV	R1,APRD.BASE+H.DACTQ+2
	CLR	(R1)
	RETURN


	.SBTTL	Attachment Routines
	.SBTTL	+	ATTCED - Attach a CED
;+
; **-ATTCED - Attach a CED
;
; Passed:
;	R0 -> CED to attach
;	R1 -> I/O packet to attach
;
;	Cache Partition mapped
;
; Returned:
;	All registers preserved
;
;	This routine will attach an I/O packet to a CED for I/O, or
;	will queue it if there is a pending operation on the CED.
;-
ATTCED::TST	I.ACED(R1)		; is this packet already attached
	BEQ	3$			; if EQ, nope, continue w/ attach

	FATAL$	BE.CAA			; CED already attached

3$:	TST	E.IOPA(R0)		; active packet already attached
	BNE	5$			; yes, queue this one

	MOV	R1,E.IOPA(R0)		; no, this one gets it (CC from TST)
	MOV	R0,I.ACED(R1)		; set ptrs in CED and URP both
	BR	10$			; and finish up

5$:	CMP	E.IOPA(R0),R1		; is this packet owner already?
	BEQ	10$			; yes, return easy success


	MOV	R1,@E.ATTL+2(R0)	; attach packet at end of queue
	MOV	R1,E.ATTL+2(R0)		; update end of list ptr
	CLR	(R1)			; clear link at list end
	CLR	I.ACED(R1)		; show no CED attached to this URP
	SEC				; tell caller some other is owner

10$:	RETURN

	.SBTTL	+	DETCED - Detach extents involved with an I/O
;+
; **-DETCED - Detach extents involved with an I/O
;
; Passed:
;	R0 -> CED to be freed
;		Packets in E.ATTL are waiting for extent, will be
;		queued to Phase 2.
;	E.IOPA(R0) -> active packet, zero it here (for ATTCED flag)
;	R1 -> I/O packet of original attacher
;
;	NOTE: E.PCNT is no longer valid, only one op is active on extent
;	at any time.  Others are queued and resumed in Phase II.
;
;	Extent will be deleted if ES.DEL is set.
;
;
; Returned:
;	All registers preserved
;
; Action:
;	A "lock" is simply an owner of a given extent (E.IOPA)
;
;	Any waiting requests queued to the extent are requeued to the
;	list headed by H.PKTQ for Phase II processing.  Phase II will
;	dispatch to resume the processing that was blocked waiting
;	for this extent to free up.
;
;	If the CED being detached is contiguous with the previous
;	CED, and does not exceed maximum extent size, we will merge
;	the two CEDs to save on pool allocations.
;
;
DETCED::MOV	R2, -(SP)		; Get work registers
	MOV	R3, -(SP)

	CMP	E.IOPA(R0),R1		; is this the attacher?
	BNE	3$			; if NE, nope, this isn't it ...

	CMP	I.ACED(R1),R0		; is this the correct attachment
	BEQ	5$			; if EQ, yes, continue

3$:	FATAL$	BE.CNA			; CED not attached by IOP

5$:	CLR	I.ACED(R1)		; packet no longer attached

	CLR	E.IOPA(R0)		; and show no active packet

	MOV	E.ATTL(R0),R2		; Get address of first CRP attac
	BEQ	10$			; none in queue, finish up

	MOV	R2,@APRD.BASE+H.PKTQ+2	; splice to end of queue for Phase II
	MOV	E.ATTL+2(R0),APRD.BASE+H.PKTQ+2	; point at end of queue

	CLR	E.ATTL(R0)		; no longer any attachers

	MOV	R0,E.ATTL+2(R0)		; set the CED queue to empty
	ADD	#E.ATTL,E.ATTL+2(R0)

10$:	BITB	#ES.DEL, E.STAT(R0)	; Should this be deleted?
	BEQ	20$			; If EQ, no

	MOV	E.LPRV(R0),-(SP)	; extract the previous CED address
	BIT	#1,I.TCB(R1)		; are we in a purge operation?
	BEQ	15$			; if EQ, nope, they want a valid CED

	MOV	R0,(SP)			; use this CED for deletion

15$:	CALL	FRECED			; Delete the extent
	MOV	(SP)+,R0		; and update the new CED
					; If CS, deferred - not a problem
	BNE	40$			; we didn't pull a null
;+
;   Note: The following section of code will preserve the status
;	  of carry (CC-C) for the calling subroutine.
;-
	MOV	KISAR6,-(SP)		; save kernel mapping
	MP.UCBX				; map our UCBX
	MOV	APR6.BASE+X.CCED,R0	; get the first CED in the list
	MOV	(SP)+,KISAR6		; restore kernel mapping
	BR	40$			; finish up


;+
;   This CED will not be deleted, so make a simple check to determine
; if this CED is adjacent to the previous CED, and if so, merge the
; two CED together, provided that they do not exceed the read-ahead
; parameters. This will handle any contiguous extents, and maximize the
; available pool ...
;-
20$:	CMP	E.LPRV(R0),E.BPRV(R0)	; do both base/lbn point to the
	BNE	35$			; if NE, nope, don't do this ...

	MOV	E.LPRV(R0),R3		; get the previous CED address
	BEQ	40$			; this is the first CED

	CMP	E.LBNH(R3),E.LBNL(R0)	; are these CED's contiguous?
	BNE	35$			; if NE, nope ...
	CMP	E.LBNH+2(R3),E.LBNL+2(R0)	; and now the MSP		;DC430
	BNE	35$			; nope, finish up ...			;**-1

	MOVB	E.SIZE(R3),R2		; get the size of the previous CED
	ASH	#3,R2			; convert to 32.wd blocks
	ADD	E.PHYA(R3),R2		; calculate the top address
	CMP	E.PHYA(R0),R2		; are they contiguous?
	BNE	35$			; nope, they are not contiguous

	CMPB	E.STAT(R3),E.STAT(R0)	; are they like CED's (i.e. deferred
	BNE	35$			; nope, can't merge them together
;+
;   These CED's are identical, and contiguous .... so merge them togethe
; if we are allowed, and don't exceed read-ahead size
;-
	CLR	-(SP)			; make a scratch word
	MOV	KISAR6,-(SP)		; save KISAR6
	MP.UCBX				; and map to the UCBX
	MOVB	APR6.BASE+X.CSTS,3(SP)	; save the status byte
	MOVB	APR6.BASE+X.XRDA,2(SP)	; and the size parameter ...
	MOV	(SP)+,KISAR6		; restore kernel APR6 mapping

	BIT	#<XC.RDA*256.>,(SP)	; is read-ahead allowed?
	BEQ	30$			; if EQ, nope ... (all that comparing)

	CLRB	1(SP)			; insure high byte is clear

	MOVB	E.SIZE(R3),R2		; load the size of the previous
	CLR	-(SP)			; prepare to set up our size
	MOVB	E.SIZE(R0),(SP)		; and the size of this extent
	ADD	(SP)+,R2		; compute total
	CMP	R2,(SP)+		; are we too big?
	BHI	35$			; if HI, yes, can't merge extent
;+
;   There are no violations, so merge the two extents, and free up the
; additional CED ...
;-
	CLR	-(SP)			; and set an accumulator
	MOVB	E.SIZE(R0),(SP)		; save the size to extend
	MOV	R3,-(SP)		; save the target CED for merge

	CLRB	E.STAT(R0)		; if deferred, don't write it out
	CALL	FRECED			; delete the CED

	MOV	(SP)+,R0		; restore the new detached extent
	MOVB	E.SIZE(R0),R2		; get the extent size
	ADD	(SP),E.LBNH(R0)		; update the highest LBN
	ADC	E.LBNH+2(R0)		; double precision ...			;DC430
	ADD	(SP),R2			; compute new size byte			;**-1
	MOVB	R2,E.SIZE(R0)		; and we are all updated

	CALL	QUPAGE			; pre-age this extent to the end

30$:	TST	(SP)+			; clean the stack

35$:	CLC				; insure carry is clear

40$:	MOV	(SP)+, R3		; Restore work registers
	MOV	(SP)+, R2
	RETURN

	.SBTTL	Structure Allocation/Deallocation
	.SBTTL	+	CRECED - Create CED block
;+
; **-CRECED - Create CED block
;
; Passed:
;	R1 - URP
;
; Returned:
;	R0 ->	Newly allocated CED
;		E.ATTL (R0) = 0
;		E.ATTL+2 (R0) => E.ATTL(R0)
;-
CRECED::MOV	R1,-(SP)		; save URP address

	MOV	#E.LGTH,R1		; Set size to allocate
	CALL	.ALOCB			; Call internal allocation routine
	BCS	90$			; failure, tell caller the bad news

	CLRB	E.STAT(R0)		; clear E.STAT				;DC430
	CLR	E.IOPA(R0)		; no active packet			;**-2
	CLR	E.ATTL(R0)

	MOV	R0,E.ATTL+2(R0)		; set empty attachment queue
	ADD	#E.ATTL,E.ATTL+2(R0)

90$:	MOV	(SP)+,R1		; restore R1
	RETURN				; to caller

	.SBTTL	+	DELCED - Delete CED block
;+
; **-DELCED - Delete CED block
;
; Passed:
;	R0 ->	The CED to be deallocated
;
; Returned:
;	All registers preserved
;-
DELCED:	MOV	R1,-(SP)

	MOV	#E.LGTH,R1		; Set size to deallocate
	CALL	.DEACB			; Call internal deallocation routine

	MOV	(SP)+,R1
	RETURN


	.SBTTL	Buffer address conversion routines
	.SBTTL	+	ADJBUF - Convert NPR buffer addresses to doubleword
;+
; ADJBUF - Adjust buffer address
;
; Passed:
;	R1 -> I/O packet to adjust
;	R5 -> UCB
;
; Returned:
;	Nil.
;
;	This routine will replace the 22-bit buffer address for
;	UC.NPR devices with an address doubleword for use by
;	the $BLXIO (block move) routine.
;-
ADJBUF::
	BITB	#UC.NPR,U.CTL(R5)	;Is device NPR?
	BEQ	10$			;No if EQ; leave address "as is"

	MOV	R2,-(SP)		;Get two work registers
	MOV	R3,-(SP)		;

	MOV	I.PRM+P1.1(R1),R2	;Get the MSB of the address
	MOV	I.PRM+P1.2(R1),R3	;Get the LSB of the address

	.IFNDF	M$$EXT			;18-bit system
	ASH	#4,R2			;Shift <21:20> into <17:16>
	.IFF				;M$$EXT
	SWAB	R2			;Shift <31:24> into <23:16>
	.ENDC	; M$$EXT

	BIC	#^C<77>,I.PRM+P1.2(R1)	;Remove all but low 6 bits
	BIS	#APR6.BASE,I.PRM+P1.2(R1) ;Create APR6 displacement
	ROL	R3			;Shift out <15> from LSB
	ROL	R2			;And pick up in MSB
	ROL	R3			;Shift out <14> from LSB
	ROL	R2			;And pick up in MSB
	SWAB	R3			;Shift <13:6> into low 8 bits
	SWAB	R2			;Shift <21:14> into place
	BISB	R3,R2			;Set <13:6> into APR bias
	MOV	R2,I.PRM+P1.1(R1)	;Create APR bias

	MOV	(SP)+,R3		;Restore saved registers
	MOV	(SP)+,R2		;

10$:	RETURN				; All set

	.SBTTL	Buffer management
	.SBTTL	+	GETBUF - Allocate a buffer from cache
;+
; **-GETBUF - Allocate a buffer from cache
;
; Passed:
;	R1 -> User's I/O packet
;	R4 := length required in 512-byte blocks
;	R5 -> UCB of request device
;
; Returned:
;	CC:	R0 -> Available CED
;	CS:	No CED available
;
;	Attempts to allocate space can be provided through various
;	algorithms.
;
;	The first algorithm attempts to reuse free
;	space as quickly as possible, by searching the extent list
;	for "holes" of unused bufferspace.  (Note that all holes
;	will be block increments.)  If a search of the extent list
;	fails to find any free space, then the oldest item in the
;	extent age list will be deallocated.  Another attempt to
;	allocate space will be tried.  A failure at this point will
;	cause the request to be bypassed.
;-
GETBUF::CALL	GETFRE			;Attempt to allocate free space
	BCC	10$			;Space found, use it

	CALL	FREAGE			; none, delete oldest to free sp
	BCC	GETBUF			; delete succeeded, try again
10$:
	RETURN				; C-bit status correct

	.SBTTL	+	GETFRE - Allocate free space in CED list
;+
; **-GETFRE - Allocate free space in CED list
;
; Passed:
;	R1 -> User's I/O packet
;	R4 := Number of 256-word blocks needed
;	R5 -> UCB of request device
;
; Returned:
;	CS indicates either no buffer space available,
;	   or that a CED to describe that space cannot
;	   be allocated
;	CC:
;	   R0 -> New CED to be completed, with space
;		 allocated.
;
;R2,R3 insignificant
;R4,R5 preserved
;
;	To obtain the address and length
;	of any free space (between allocations), the following
;	algorithm is used:
;
;	size = ADDRESSOF(ced[n+1]) - ADDRESSOF(ced[n]) - SIZEOF(ced[n])
;
;	base = ADDRESSOF(ced[n]) + SIZEOF(ced[n])
;
;	Special handling is required for the first and last CEDs in
;	the list.  The first one is treated as the [n+1] element,
;	with the base of the data buffer portion of the partition
;	being the address of the [n] element (SIZEOF(n) is zero).
;
;	The last element is treated as the [n] element, with the
;	address of the end being the base of the data portion of
;	the partition plus the size of same area.
;
;	This routine will scan the CED list for free space.
;	Free space is the unallocated portion between the
;	allocated extents.  The entire list must be checked
;	in order to find it.
;
;
;	If there is room adjacent to the previous CED in the LBN
;	list, the scan will begin there ...
;
;-
GETFRE: MOV	R1,-(SP)		;Save the I/O packet address
	MOV	APRD.BASE+H.CMDF,-(SP)	; get the base memory CED to start

	MOV	APRD.BASE+H.TMP,R0	; get the previous CED (by LBN)
	BEQ	5$			; if EQ, there is no previous

	MOV	I.PRM+P4(R1),-(SP)	; save the P4 parameter			;DC430
	BIT	#DV.32B,U.CW1(R5)	; device using 32-bit LBNs?		;DC430
	BNE	2$			; if NE, yes, compare whole thing	;DC430
										;DC430
	CLRB	1(SP)			; clean off the high order stuff	;DC430
										;DC430
2$:	CMP	E.LBNH+2(R0),(SP)+	; will they be adjacent?		;DC430
	BNE	5$			; if NE, nope ...			;**-1

	CMP	E.LBNH(R0),I.PRM+P5(R1)	; how about the low order LBN
	BNE	5$			; nope, don't bother

	BITB	#ES.WPL,E.STAT(R0)	; is this a place holder?
	BNE	5$			; if NE, yes, can't make it adjacent

	CLR	R2			; determine if there is enough?
	BISB	E.SIZE(R0),R2		; and include the size
	ASH	#3,R2			; compute next available address
	ADD	E.PHYA(R0),R2		; total it all up
	MOV	(R0),R3			; get the "next" buffer address
	MOV	E.PHYA(R3),R3		; and it's base address
	SUB	R2,R3			; compute the difference
	MOV	R4,R2			; copy desired size
	ASH	#3,R2			; convert requested size
	CMP	R3,R2			; is it big enough?
	BHIS	10$			; if HIS, yes, use it ...

5$:	MOV	APRD.BASE+H.CMDH,R0	;Address of first CED
	TST	APRD.BASE+H.CMDF	; do we have a starting point?
	BEQ	10$			; if EQ, nope, use CMDH to start

	CLR	(SP)			; flag no holes detected ... yet
	MOV	APRD.BASE+H.CMDF,R0	; get a good starting CED

; Assume E.BNXT = 0 for source

10$:	MOV	(R0), R1		;Address of next physical extent
	BEQ	30$			;End of extent list if EQ

	CLR	R2			; Prepare to get byte.
	BISB	E.SIZE(R0),R2		; Get size of extent in 512-byte
	ASH	#3,R2			; Convert to APR bias.
	ADD	E.PHYA(R0),R2		;Add base for possible free space
	MOV	E.PHYA(R1),R3		;Get the address of the "next"
	SUB	R2,R3			;Subtract free address for length
	BNE	20$			;Free space available - check it

15$:	MOV	R1,R0			;Else advance in the CED list
	BR	10$			;And look for space

20$:	TST	(SP)			; do we have a CED to start later?
	BNE	25$			; yup, continue ...

	MOV	R0,(SP)			; set up a starting point

25$:	ASH	#-3,R3			; Convert to 512-byte blocks to
	CMP	R3,R4			; Is this free space big enough?
	BLO	15$			;Too small if LO; keep searching
;
; Context:
;
;	R0 -> Low CED of free space
;	R1 -> High CED of free space
;	R2 := Physical address of free space
;	R3 := Length of free space
;	R4 := Length of requested free space
;	R5 -> UCB of disk device
;
; The following must be done:
;
;	1. A CED allocated for the new extent
;	2. The new CED linked into the physical address
;	   list, positioned between the R0-> and R1-> CED
;	3. The new CED placed at the end of the age list (BY CALLER)
;	4. The new CED inserted at the appropriate point
;	   in the LBN list (BY CALLER)
;
	MOV	R0,R3			;Free up R0 for use
	CALL	CRECED			;Create a CED now
	BCS	40$			; If CS, none are available for use

	MOV	R2,E.PHYA(R0)		;Establish our address
	MOVB	R4,E.SIZE(R0)		;Establish our size

; Assume E.BNXT = 0 for destination

	MOV	R0, (R3)		;Point previous to us
	MOV	R3,E.BPRV(R0)		;Point us to previous
	MOV	R0,E.BPRV(R1)		;Point next to us

; Assume E.BNXT = 0 for destination

	MOV	R1, (R0)		;Point us to next
	MOV	R5,E.UCB(R0)		;Plug in owning device's UCB address
	TST	(PC)+			;Return CC for success

30$:	SEC				;Indicate no space available

40$:	MOV	(SP)+,APRD.BASE+H.CMDF	; and update the next starting CED
	MOV	(SP)+,R1		;Restore saved R1
	RETURN


	.SBTTL	+	FREAGE - Unlink and deallocate first age list entry
;+
; **-FREAGE - Unlink and deallocate first age list entry
; **-FRECED - Unlink and deallocate a cache extent
;
; Alternate entry:
;	FREAGE - Deallocate oldest extent from age list to free
;		 cache internal pool and buffer space
;	DELBUF - Deallocate a buffer from all lists without checking
;		 busy or deferred status bits (caller is responsible)
;
; Passed:
;	R0 -> CED to be deallocated
;	R5 -> UCB Address of device
;
; Returned:
;	CC:	CED is deleted
;	CS:	CED is marked for deletion later
;
;	All registers preserved
;
;	Prior to deallocation, the CED must be removed from:
;
;		1. The age list
;		2. The LBN list
;		3. The address list
;
; NOTE:	If the extent is "busy" or "locked down" it will be marked for
;	deletion during I/O completion.
;-
	.ENABL	LSB

FREAGE::CLR	APRD.BASE+H.CMDF	; insure we start from the start
	MOV	APRD.BASE+H.CEDH,R0	; get oldest CED from age list

20$:	BEQ	110$			; empty list, hunh?

	CALL	FRECED			; attempt to free this CED
	BCC	120$			; if CC, we released a CED

	TST	E.IOPA(R0)		; do we have active I/O
	BNE	110$			; if NE, yes, return this one

	MOV	E.ANXT(R0),R0		; get the next CED in the age list
	BR	20$			; and retry with the next element


	.SBTTL	+	FRECED - Unlink and deallocate a cache extent


FRECED::TST	E.IOPA(R0)		;Extent busy?
	BNE	100$			; If NE, yes, don't deallocate it

	BITB	#ES.WDF,E.STAT(R0)	; Is write deferred ?
	BEQ	200$			; If EQ, no

	CALL	QUPAGE			; yes, move to front of age list
					; ...FRECED calls don't just spin

	BITB	#ES.ERR,E.STAT(R0)	; Is there an error with this CED
	BNE	110$			; If NE, yes, skip this one

	CALL	WRTDFR			; write the deferred extent now
	BCS	110$			; no pool error returned by WRTDFR

100$:	BISB	#ES.DEL, E.STAT(R0)	; Mark for deletion later

110$:	SEC				; Indicates busy extent still exists
120$:	RETURN				; to caller

;
; 	called to delete CED from all lists w/o checking for busy or defer
;	   called by DCCTL for forced deactivation of cache (implictly imvoked
;	   for VV$CLR from dismount, should be no valid defers remaining) and
;	   called by DCCTL for FUNDEL to handle ACP function to purge cache
;	   for deallocation of blocks from a file.
;
;
; Remove CED from lists now that we know it's ok to delete it
;
;
; Don't remove write placeholder from lists it isn't in
;
200$:	BITB	#ES.WPL,E.STAT(R0)	; is this a placeholder for write
	BNE	210$			; yes, only in LBN list, skip others

	; Remove from age list and memory buffer list

	CALL	QRMAGE			; Remove from the age queue

	CALL	QRMBUF			; Remove from memory buffer list
;
; Update pointer for LBN list positioning if deleting the "current" CED
;
210$:	CMP	R0,APRD.BASE+H.TMP	; deleting CED pointed to as current
	BNE	220$			; no, ok, go on
	MOV	E.LPRV(R0),APRD.BASE+H.TMP	; yes, update ptr

220$:	CALL	QRMLBN			; Remove from the LBN queue
	CALL	DELCED			; Delete the CED

	CLC				; Indicates success
	RETURN

	.DSABL	LSB

	.SBTTL	Write deferred I/O operations
	.SBTTL	+	WRTDFR - Write deferred data in CED to disk
;+
; WRTDFR - Routine to write out specified deferred extent to disk
;
; Inputs:
;	R0 - CED with data to be written to disk
;	R1 -> I/O packet for write (in primary pool)
;	R5 - UCB address of device for request causing write (not necessarily
;		the device being written, if age list is being purged!)
;
; Outputs:
;	CC - I/O packet queued to driver to write data in extent
;	CS - error
;-
WRTDFR::CALL	$SAVAL			; save all registers

	MOV	E.UCB(R0),R5		; Get new UCB address from CED
	CALL	DFRPKT			; fill in I/O packet
	BCS	20$			; UGH, didn't get pool for one...

	CALL	ATTCED			; attach to CED, should succeed!
	BCC	10$			; if CC, we made it

	FATAL$	BE.CAA			; CED already attached

10$:	BISB	#ES.WIP,E.STAT(R0)	; Indicate a write-in-progress
	CALL	.DRQRQ			; Initiate the I/O for the extent
	MP.PAR				; ensure cache partition still mapped

20$:	RETURN				; to caller


	.SBTTL	+	DFRPKT - Fill in internal I/O packet for deferred extent
;+
; DFRPKT - Routine to set up internal I/O packet for deferred write
;
; Inputs:
;	R0 - CED with data to written to disk
;	R1 -> I/O packet to be initialized
;	R5 - UCB address of device
; Outputs:
;	CC:
;	   R1 - I/O packet allocated and partially filled
;	CS:
;	   Allocation failure for I/O packet
;-
DFRPKT::MOV	R0,-(SP)		; Save the CED address

	MOV	#I.LGTH,R1		; Get size to allocate
	CALL	$ALOCB			; Allocate I/O packet
	BCS	50$			; If CS, allocation failure
;
; First clear the packet and then fill in necessary data for call to driver
;
	MOV	R0,-(SP)		; Save I/O packet address
	ROR	R1			; convert to words
10$:	CLR	(R0)+			; zero out a word
	SOB	R1,10$			;
	MOV	(SP)+,R1		; Restore packet address into R1

	MOV	$LDRPT,R0		; Take priority of ...LDR for packet
	BISB	T.PRI(R0),I.PRI(R1)	; set up priority
	MOV	R0,I.TCB(R1)		; Also make it the owning task TCB

	MOV	R5,I.UCB(R1)		; Put in UCB address of device
	MOV	#IO.WLB,I.FCN(R1)	; Make this a logical write operation
	MOV	KINAR5,I.IOSB+2(R1)	; Set up internal I/O completion
	MOV	#DFRIOC!1,I.IOSB+4(R1)	; ... address and flag
	CLRB	I.EFN(R1)		; insure logical I/O

	MOV	(SP),R0			; Restore the CED address
	MOV	R0,I.CRP(R1)		; Keep pointer to CED in packet

	MOV	E.LBNL(R0),I.PRM+P5(R1)	; Get LSP of LBN to write to disk
	MOV	E.LBNL+2(R0),I.PRM+P4(R1) ; Get MSP of LBN			;DC430
										;**-1
	MOVB	E.SIZE(R0),R2		; Get size of transfer in blocks
	ASH	#9.,R2			; Turn that into bytes
	MOV	R2,I.PRM+P2(R1)		; Put byte value into I/O packet

	MOV	R1,R4			; Save address of I/O packet
	MOV	#APR6.BASE,R2		; Get APR6 displacement
	MOV	E.PHYA(R0),R1		; Get APR bias of start of buffer
	CALL	$MPPHY			; Map to physical address if NPR
	MOV	R1,I.PRM+P1.1(R4)	; Move MSP to I/O packet
	MOV	R2,I.PRM+P1.2(R4)	; Move LSP to I/O packet
	MOV	R4,R1			; Restore pointer to I/O packet

	.IF DF	S$$HDW
;+
;  In order to insure shadowing integrity, we will also need to
;    allocate an ML node for the deferred I/O
;-
	MOV	U.UMB(R5),R4		; extract the UMB address
	BEQ	50$			; if EQ, no shadow pair

	BIT	#MS.MDA,M.STS(R4)	; can we allocate new packets?
	BNE	50$			; if NE, nope, continue ...

	MOV	R1,R3			; copy the packet address to R3

	MOV	#ML.LGH,R1		; set the length to allocate
	CALL	$ALOCB			; allocate primary pool for ML node
	BCC	20$			; we got pool, go continue

	MOV	R3,R1			; restore IOP
	USTAT$	0,#APR6.BASE+S.POL	; error allocating pool

	MOV	R3,R0			; set up to deallocate the packe
	MOV	#I.LGTH,R1		; and the length
	CALL	$DEACB			; deallocate the packet
	SEC				; flag error
	BR	50$			; and finish out ...

20$: 	MOV	R0,R1			; copy ML node address
	CLR	(R0)+			; Clear link word
	MOV	#<ML.LGH+<MT.PKT*256.>>,(R0)+	; ML.LEN/ML.TYP
	CLR	(R0)+			; ML.DNC/Unused set done count
	MOV	R3,(R0)+		; ML.PRI  set primary I/O packet
	MOV	M.LHD(R4),(R1)		; link new node to previous first
	MOV	R1,M.LHD(R4)		; point listhead to new node

40$:	MOV	R3,R1			; restore I/O packet address

	.ENDC	;DF S$$HDW

50$:	MOV	(SP)+,R0		; Restore CED address
	RETURN


	.SBTTL	+	DFRIOC - I/O completion routine for deferred extent
;+
; DFRIOC - Routine to complete processing after a deferred extent has been
;	written to disk
;
; Inputs:
;	R3 - I/O packet address
;
;-
DFRIOC:	CALL	$SAVAL			; save all registers for $IOFIN

	MOV	I.ACED(R3),R0		; Point to CED
	MOV	I.UCB(R3),R5		; Get UCB address of device

	MP.PAR				; map cache partition


	BITB	#CS.DBG,APRD.BASE+H.CSTS	; debug enabled?
	BEQ	7$			; nope, skip this

	CMP	E.IOPA(R0),R3	; is this packet for this ced?
	BNE	3$		; no, go die ...
	CMP	E.UCB(R0),R5	; ucb match ced?
	BEQ	7$		; ok, sanity checked

3$: 	FATAL$	BE.UCB		; bad UCB address

7$:	.IF DF	CHEWBH
	BICB	#ES.WIP,E.STAT(R0)	; Indicate extent no longer WIP
	.IFF	;DF,CHEWBH
	BICB	#<ES.WIP!ES.WDF>,E.STAT(R0) ; Indicate extent no longer WIP/DFR
	.ENDC	;DF,CHEWBH
	TSTB	I.PRM+P3(R3)		; See if there was an error
	BPL	10$			; If PL, no error

	ASSUME	ES.DEL,200
	TSTB	E.STAT(R0)		; force delete? (for deactivate)
	BMI	20$			; yes

	BISB	#<ES.ERR!ES.WDF>,E.STAT(R0)	; Show error on deferred CED
	CALL	QUPAGE			; move CED w/err to front of age list
	BR	20$			; (must retain until file deleted!)

10$:	.IF DF	CHEWBH
	BITB	#ES.WDF,E.STAT(R0)	; was this a deferred extent?
	BEQ	20$			; if EQ, nope, don't delete on detach

	BICB	#ES.WDF,E.STAT(R0)	; else, no longer deferred, and delete

	.ENDC	;DF,CHEWBH
	BISB	#ES.DEL,E.STAT(R0)	; set flag to delete CED in detach

20$:	MOV	R3,R1			; copy I/O packet to R1 for DETCED
	CALL	DETCED			; detach CED, requeue pending rqst

	MOV	R3,R0			; setup for internal I/O pkt deallocate
	MOV	#I.LGTH,R1		; set up the length
	CALL	$DEACB			; return packet to pool

	CALLR	DCFRK0			; fork and run Phase II if needed


	.SBTTL	Memory allocation routines
	.SBTTL	+	.ALOCB - Internal hook to $ALOCB
;+
; **-.ALOCB - Internal hook to $ALOCB
;
; Passed:
;	R1 :=	Requested size
;
; Returned:
;	R1 :=	Size rounded up according to blocking factor
;	If CC then successfully allocated block
;		R0 ->	Newly allocated block
;	If CS then no memory available
;
;	This routine will allocate memory from the cache partition
;	using the system memory allocation routine $ALOCB in CORAL.
;	Entry point $ALOC1 is called with the internal header address.
;
.ALOCB:	MOV	R2,-(SP)		; save R2

	MOV	#APRD.BASE+H.PAVL,R0	; R0 -> Internal pool list heade
	CALL	$ALOC1			; Attempt to allocate the memory

	MOV	(SP)+,R2		; restore R2
	RETURN

	.SBTTL	+	.DEACB - Internal hook to $DEACB
;+
; **-.DEACB - Internal hook to $DEACB
;
; Passed:
;	R0 ->	Block to be deallocated
;	R1 :=	Length of block
;
; Returned:
;	All registers preserved
;
;	This routine will deallocate memory in the cache partition,
;	or into system pool depending upon the address.  This enables
;	the cacher to allocate space from primary pool in cases of
;	extreme emergency (not currently used).
;-
.DEACB:	MOV	R0,-(SP)		; save work registers
	MOV	R2,-(SP)
	MOV	R3,-(SP)

	CMP	R0,#APR5.BASE		; System pool or cache pool?
	BLO	10$			; System pool if LO

	MOV	#APRD.BASE+H.PAVL,R3	; R3 -> Internal pool list header
	CALL	$DEAC1			; Attempt to deallocate the memory
	BR	20$			; Go to common exit

10$:	CALL	$DEACB			; Deallocate it to system pool

20$:	MOV	(SP)+,R3		; restore work registers
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RETURN


	.SBTTL	EBLXIO -- BLXIO Extension
;+
; **-EBLXIO -- BLXIO Extension
;
;	This routine performs the same operation as $BLXIO, except it
;	extends the amount that may be transferred from under 4K bytes to
;	65535 bytes.  Forks are performed between calls to $BLXIO.
;
;
;	Input:
;
;	R0	number of bytes to be transferred
;	R1	starting APR bias for source
;	R2	starting offset for source (must be less than 100 octal)
;	R3	starting APR bias for destination
;	R4	starting offset for destination (must be less than 100 octal
;	On a multiprocessor system, we have the executive lock.
;
;
;	Output:
;
;	R0-R4	altered
;	R5	preserved
;-
	.IFDF	M$$PRO			; Is multiprocessor support required
FRKSIZ	=	14			; Yes, fork block is six words.
	.IFF
FRKSIZ	=	12			; No, fork block is five words.
	.ENDC
	.IFDF	K$$DAS			; Are we using data space?
REGSIZ	=	4			; The cache region APRs take two
	.IFF
REGSIZ	=	2			; The cache region APR takes one
	.ENDC

EBLXIO::.IF DF	M$$PRO
	TST	APRD.BASE+H.PKTQ	; any pending work to do?
	BEQ	10$			; nope, skip the extra work

	MOV	#10$,-(SP)		; set up a return address
	CALL	$SAVAL			; save all registers
	CALLR	DCFRK0			; and check for more work

10$:	ULOCK$	$EXECL,WAIT		; Yes, release the executive lock
	.ENDC	;DF,M$$PRO
	MOV	R5,-(SP)		; Save register.
	CLR	R5			; Flag no block allocated.

	MOV	R0,-(SP)		; Save count of bytes to move.
	MOV	#MAXTR,R0		; Get maximum size of single transfer
	SUB	R0,(SP)			; Subtract bytes to be transferr
	BCC	210$			; There are enough; do transfer.
	ADD	(SP),R0			; The maximum is too much, adjust
	CLR	(SP)			; Zero bytes will be left.

210$:	.IF DF	DC$DBG&K$$DAS
	CMP	R3,$SCMOF		; size above exec?
	BLOS	235$			; if LOS, fatal
	CMP	R4,#140000		; address in APR6?
	BLO	235$			; if LO, fatal
	.ENDC	;DF,DC$DBG&K$$DAS
	CALL	$BLXIO			; Transfer data.
	TST	(SP)			; Are we done?
	BEQ	255$			; Yes, leave.

	MOV	KISAR6,-(SP)		; Save APR for cache region.
	.IFDF	K$$DAS			; Are we using data space?
	MOV	KISAR5,-(SP)		; Save second APR for cache region
	.ENDC
	MOV	R4,-(SP)		; Save register.
	MOV	R3,-(SP)		; Save register.
	MOV	R2,-(SP)		; Save register.
	MOV	R1,-(SP)		; Save register.
	MOV	#$STACK-22+FRKSIZ,R1	; Get location where we want SP
					; be, plus space for fork block.
	SUB	SP,R1			; Figure size of block needed for
					; for fork block plus everything
					; the stack below the task context
	LOCK$	$EXECL,WAIT		; Yes, obtain the executive lock
	CALL	$ALOCB			; Get space for fork block.
	BCC	215$			; There is space; use it.
	ULOCK$	$EXECL,WAIT		; Yes, release the executive lock
	MOV	(SP)+,R1		; Restore register.
	MOV	(SP)+,R2		; Restore register.
	MOV	(SP)+,R3		; Restore register.
	MOV	(SP)+,R4		; Restore register.
	.IFDF	K$$DAS			; Are we using data space?
	CMP	(SP)+,(SP)+		; We don't need the saved APRs.
	.IFF
	TST	(SP)+			; We don't need the saved APR.
	.ENDC
	BR	240$			; Go do the next transfer.

215$:	MOV	R0,R4			; Copy pointer.

	; Copy stack to fork block and adjust R4 for input to $QFORK.

217$:	MOV	(SP)+,(R4)+		; Copy stack word to fork block.
	CMP	SP,#$STACK-22		; Is stack copied yet?
	BNE	217$			; No, keep going.

	.IFDF	M$$PRO			; Is multiprocessor support required
	CLR	(R4)+			; We can run on any processor.
	.ENDC

	MOV	#237$,2(R4)		; Record PC to be restored by system
	MOV	R4,4(R4)		; Record R5 to be restored by sysyem
	MOV	R0,6(R4)		; Record R4 to be restored by system
	MOV	KINAR5,10(R4)		; Record APR to be restored by system
	BR	230$			; Go do fork.

	; Come back after another transfer

220$:	TST	R5			; Do we have a fork block?
	BEQ	240$			; No, go do the next transfer.
	MOV	6(R5),R0		; Point to beginning of block.
	MOV	R1,(R0)+		; Record register.
	MOV	R2,(R0)+		; Record register.
	MOV	R3,(R0)+		; Record register.
	MOV	R4,(R0)+		; Record register.
	MOV	(SP)+,REGSIZ(R0)	; Record remaining length (it goes
					; above the saved APR or APRs).
	MOV	R5,R4			; Pass fork block to $QFORK.
	.IF DF M$$PRO
	CALL	230$			; we don't need the lock to fork
	LOCK$	$EXECL,WAIT		; Obtain the executive lock
	RETURN				; to $DIRXT
	.ENDC	;DF M$$PRO

230$:	CLR	(R4)			; we will be the last in the queue
	JMP	$QFORK			; Fork.

	.IF DF	DC$DBG&K$$DAS
235$:	FATAL$	BE.IDC			; inconsistent data
	.ENDC	;DF,DC$DBG&K$$DAS

	; This label is where the system returns to.

237$:	ULOCK$	$EXECL,WAIT		; Yes, release the executive lock
	MOV	R4,R0			; Switch to another register.
	MOV	(R0)+,R1		; Restore register.
	MOV	(R0)+,R2		; Restore register.
	MOV	(R0)+,R3		; Restore register.
	MOV	(R0)+,R4		; Restore register.
	.IFDF	K$$DAS			; Are we using data space?
	MOV	(R0)+,KISAR5		; Restore cache region APR.
	.ENDC
	MOV	(R0)+,KISAR6		; Restore cache region APR.
	MOV	(R0)+,-(SP)		; Restore length remaining.

240$:	MOV	#MAXTR,R0		; Get maximum size of single trasfer
	SUB	R0,R4			; Decrease pointer by maximum size
	ADD	#MAXTRB,R3		; Increase APR by maximum size.
	SUB	R0,R2			; Decrease pointer by maximum size
	ADD	#MAXTRB,R1		; Increase APR by maximum size.
	SUB	R0,(SP)			; Subtract bytes to be transferred
	BCC	250$			; There are enough; do transfer.
	ADD	(SP),R0			; The maximum is too much, adjust
	CLR	(SP)			; Zero bytes will be left.

250$:	.IF DF	DC$DBG&K$$DAS
	CMP	R3,$SCMOF		; size above exec?
	BLOS	235$			; if LOS, fatal
	CMP	R4,#140000		; address in APR6?
	BLO	235$			; if LO, fatal
	.ENDC	;DF,DC$DBG&K$$DAS
	CALL	$BLXIO			; Transfer data.
	TST	(SP)			; Are we done?
	BNE	220$			; No, do another fork and transfer

255$:	TST	(SP)+			; Get count (now zero) off the stack
	LOCK$	$EXECL,WAIT		; Yes, obtain the executive lock
	TST	R5			; Did we allocate a fork block?
	BEQ	290$			; No, skip deallocation.
	MOV	6(R5),R0		; Get beginning of block for $DEACB
	MOV	R5,R4			; Copy pointer.
	ADD	#12,R5			; Point after end of block.
	SUB	R0,R5			; Compute length of block for $DEACB
	MOV	R5,R1			; Copy length.
	SUB	#12+REGSIZ+FRKSIZ,R5	; Subtract size of fork block and
					; values not needed on stack.
	ASR	R5			; Convert to words.
	.IFDF	M$$PRO			; Is multiprocessor support required
	TST	-(R4)			; Move past Unibus run mask.
	.ENDC

260$:	MOV	-(R4),-(SP)		; Copy saved value back to stack
	SOB	R5,260$			; Continue until done.

	CALL	$DEACB			; Release space.

290$:	MOV	(SP)+,R5		; Restore register.
	RETURN


	.SBTTL	$USTAT - Update cache statistics block
;
; Passed:
;	R1 -> I/O request packet
;	I.LNK(R1) 	-> Offset to be incremented
;	I.CRP(R1)	-> Cache Request Packet
;		CRP+R.STAT	-> Operation context
;				  (i.e. base address in stat. block)
;	R5	-> UCB
;
; Returned:
;	All registers preserved
;
; Action:
;	Increments the double-word statistics value located at the
;	specified offset (passed in I.LNK(R1) by caller) from the
;	base for the operation context specified by I.PRM+P3 in the CRP.
;
$USTAT::MOV	R0, -(SP)		; Save a work register
	MOV	KISAR6, -(SP)		; Save APR6 mapping
;
; Calculate the offset to be incremented, using R0 as a pointer, before
;
	MOV	6(SP),R0		; load statistics base address
	TST	(R1)			; is this a statistics w/o a CRP
	BMI	5$			; if MI, yes, continue ...

	MP.PAR				; CRP may be in cache pool
	MOV	I.CRP(R1),R0		; get R0 -> CRP
	MOV	R.STAT(R0),R0		; get R0 -> stat context base
	BIC	#1,R0			; insure an even address

	CMP	(R1),#S.POL		; is this a fixed statistic?
	BLO	5$			; if LO, nope, do context update

	MOV	#APR6.BASE,R0		; set up a base address

5$:	BIC	#100000,(R1)		; remove the sign bit
	ADD	(R1),R0			; Add in the offset from caller

	MP.UCBX				; Map the UCB extension
	BEQ	10$			; If EQ, there isn't one, skip it

	MOV	APR6.BASE+X.CSBA, KISAR6	; Map the statistics buffer
	BEQ	10$				; If EQ, there isn't one


	ADD	#1, (R0)+		; Update the appropriate field
	ADC	(R0)			; Double words

10$:	MOV	(SP)+, KISAR6
	MOV	(SP)+, R0
	RETURN


	.SBTTL	.DRQRQ, Insure shadow protection for I/O packet
;+
;  **-.DRQRQ- Insure shadow protection for each I/O packet
;
;	This routine is used to insure that on a device which supports
; shadowing, that each I/O packet is protected against errors. When an
; I/O request is first queued, an ML node is allocated for the request.
; As each request is queued into phase II, after $IOFIN, the ML node
; is deallocated. This routine insures that the packet is protected on
; any subsequent I/O requests.
;
;	Input:
;		R1 - I/O packet address
;		R5 - Device UCB address
;
;	Output:
;		to $DRQRQ, with packet, if needed ...
;
;-
.DRQRQ::MOV	R5,-(SP)		; save our current UCB address
	MOV	R1,-(SP)		; save the IOP address

	.IF DF	S$$HDW

	TST	U.UMB(R5)		; does this device support shadowing
	BEQ	50$			; if EQ, nope, continue

	MOV	R1,R3			; copy the packet address to R3
	CALL	$SHFND			; try to find the ML node
	BCC	30$			; ML node is found

	MOV	U.UMB(R5),R4		; extract UMB address
	BIT	#MS.MDA,M.STS(R4)	; can we allocate new packets?
	BNE	30$			; if NE, nope, continue ...

	.IF DF	S$$HLS			; shadow load sharing?

	BITB	#MS.CBP,M.STS(R4)	; can we bypass shadowing?
	BEQ	10$			; if EQ, nope ...

	CMPB	I.FCN+1(R3),#IO.RLB/256. ; valid for bypass?
	BEQ	30$			; if EQ, yes, continue ...

	.ENDC	;DF,S$$HLS
;+
; Certain error paths will cause this section of code to be entered,
;	and instead of forcing a system crash, we will handle it ...
;-
10$:	MOV	#ML.LGH,R1		; set the length to allocate
	CALL	$ALOCB			; allocate primary pool for ML node
	BCC	20$			; we got pool, go continue
;+
;  This should not happen since we just deallocated the ML node for
; this operation previously, so we should never crash here ...
;-
	FATAL$	BE.NPL			; no pool for ML node

20$: 	MOV	R0,R1			; copy ML node address
	CLR	(R0)+			; Clear link word
	MOV	#<ML.LGH+<MT.PKT*256.>>,(R0)+	; ML.LEN/ML.TYP
	CLR	(R0)+			; ML.DNC/Unused set done count
	MOV	R3,(R0)+		; ML.PRI  set primary I/O packet
	MOV	M.LHD(R4),(R1)		; link new node to previous first
	MOV	R1,M.LHD(R4)		; point listhead to new node

30$:	MOV	R3,R1			; restore I/O packet address

50$:	.ENDC	;DF S$$HDW

	CALL	$DRQRQ			; and forward on to $DRQRQ
	MOV	(SP)+,R1		; restore R1
	MOV	(SP)+,R5		; reset our UCB address
	RETURN				; to caller


	.SBTTL	+	SETLBN, Load LBN/size values into CED
;+
;  **-SETLBN- Load LBN and size parameters into CED
;
;	This routine is used to load I/O parameters from an I/O
; packet, into a newly created CED (or to update an existing CED)
;
;	Input:
;		R0 - CED to be loaded
;		R1 - I/O packet
;			I.PRM+P4 - LBN MSP
;			I.PRM+P5 - LBN LSP
;		R4 - Size of request in blocks
;
;	Output:
;
;		CED loaded with LBN/size parameters
;
;-
SETLBN::MOV	I.PRM+P4(R1),E.LBNL+2(R0)	; copy the MSP			;DC430
	BIT	#DV.32B,U.CW1(R5)		; using 32-bit LBNs?		;DC430
	BNE	10$				; if NE, yes, continue		;DC430
										;DC430
	CLRB	E.LBNL+3(R0)			; clear the high byte		;DC430
										;DC430
10$:	MOV	I.PRM+P5(R1),E.LBNL(R0)		; and the LBN LSP		;DC430
										;DC430
	MOV	E.LBNL+2(R0),E.LBNH+2(R0)	; and now the highest LB	;DC430
	MOV	I.PRM+P5(R1),E.LBNH(R0)		; and also the LSP		;**-4

	ADD	R4,E.LBNH(R0)			; add the total blocks
	ADC	E.LBNH+2(R0)			; double precision		;DC430
										;**-1
	MOVB	R4,E.SIZE(R0)			; and load in the extent
	RETURN					; to caller


	.SBTTL	+	UPDLBN -- Update LBN parameters if extent is deferred
;+
;   UPDLBN -- Update LBN parameters if extent is deferred
;
;	This routine is called from both FUNDEL, and DCFLSH to determine
;  if an overlapping CED is deferred, and if so, insure that the portion
;  which does not overlap is retained in cache.
;
;	Input:
;		R0 - CED to be deleted
;		R2 - LSP of highest LBN of request
;		R3 - MSP of highest LBN of request
;
;	Output:
;		CC-C clear, not deferred, all registers preserved
;		CC-C set,   deferred extent
;
;-
UPDLBN::CLC				; insure carry clear
	BITB	#ES.WDF,E.STAT(R0)	; is this deferred?
	BEQ	20$			; nope, just delete it ...

	MOV	R2,-(SP)		; save R2
	MOV	R3,-(SP)		; and R3

	NEG	R2			; we need to subtract the value
	ADD	E.LBNH(R0),R2		; compute the difference we get
	MOVB	E.SIZE(R0),R3		; get the extent size
	SUB	R2,R3			; compute how much to adjust LBN
;+
;   R2 :== new size of the extent
;   R3 :== number of blocks removed from the front of extent
;-
	ADD	R3,E.LBNL(R0)		; compute new starting LBN
	ADC	E.LBNL+2(R0)		; double precision			;DC430
	ASH	#3,R3			; convert to 32.wd blocks		;**-1
	ADD	R3,E.PHYA(R0)		; and set up the base address
	MOVB	R2,E.SIZE(R0)		; update the extent size

	MOV	(SP)+,R3		; restore R3
	MOV	(SP)+,R2		; and R2

	SEC				; flag updated CED

20$:	RETURN

	.ENDC	; D$$CHE
	.END